home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb40.zip / SCOLOR.200 < prev    next >
Text File  |  1985-09-08  |  7KB  |  159 lines
  1. {**********************************************************************}
  2. {*          S C O L O R . I N C   :    Select Color from palette      *}
  3. {*                                                                    *}
  4. {*               Separate this file into SCOLOR.200                   *}
  5. {**********************************************************************}
  6. {----------------------------------------------------------------------}
  7. {      S e l e c t _ C o l o r  : Ask for Color and Return Attribute   }
  8. {----------------------------------------------------------------------}
  9. { Ask user to choose a color foreground and background and return the  }
  10. { attribute.                                                           }
  11. { Input:   Attribute at which to position the first Cursor             }
  12. { Output:  Atribute selection by the user or Zero                      }
  13. {**********************************************************************}
  14. Procedure Select_Color(Var Attr: byte) ;
  15.    Const
  16.        Arr_Up    = 72 ;
  17.        Arr_Dn    = 80 ;
  18.        Arr_Right = 77 ;
  19.        Arr_Left  = 75 ;
  20.        Return    = 13 ;
  21.        Esc       = 27 ;
  22.    Var
  23.        Fieldwidth,
  24.        ColorMatrixX,ColorMatrixY,
  25.        Foreground
  26.                            :integer;
  27.        ch                  :char;
  28.        Old_Attr,
  29.        Old_Text,
  30.        Old_background,
  31.        Chval               :byte;
  32. {----------------------------------------------------------------------}
  33. {   B l i n k  the Cursor Position On/Off                              }
  34. {----------------------------------------------------------------------}
  35.  Procedure Blink_Off;                  { Turn off blinking             }
  36.    Var
  37.       x,y :integer;
  38.    Begin
  39.    x := WhereX; y := WhereY;           { Save old cursor position      }
  40.    For I := x to x+FieldWidth-1 do
  41.       Begin
  42.       GotoXY(I,y);BlinkChar(Off);
  43.       end;
  44.    GotoXY(x,y);                        { Restore old cursor position   }
  45.    End;
  46.  
  47.  Procedure Blink_On;                   { Turn off blinking             }
  48.    Var
  49.       x,y :integer;
  50.    Begin
  51.    x := WhereX; y := WhereY;           { Save old cursor position      }
  52.    For I := x to x+FieldWidth-1 do
  53.       Begin
  54.       GotoXY(I,y);BlinkChar(On);
  55.       end;
  56.    GotoXY(x,y);                        { Restore old cursor position   }
  57.    End;
  58.  
  59. {----------------------------------------------------------------------}
  60. {      Move_Right_Left_Up_Dn : Cursor Move Routines                    }
  61. {----------------------------------------------------------------------}
  62. Procedure Move_Right;                  { Move Cursor right one position}
  63.    Begin                               { Restore unblinking attributes }
  64.    Blink_Off;                          { to old cursor postion         }
  65.    ColorMatrixX :=(ColorMatrixX + FieldWidth);
  66.    If ColorMatrixX > 16*Fieldwidth then ColorMatrixX := Fieldwidth;
  67.    GotoXY(ColorMatrixX,ColorMatrixY); { Move to new cursor postion and}
  68.    Blink_On;                          { set blinking attribute        }
  69.    End; {Move_Right}
  70.  
  71. Procedure Move_Left;                   { Move Cursor Left one position }
  72.    Begin                               { Restore unblinking attributes }
  73.    Blink_Off;                          { to old cursor postion         }
  74.    ColorMatrixX := ColorMatrixX - FieldWidth;
  75.    If (ColorMatrixX < FieldWidth) then
  76.        ColorMatrixX := FieldWidth*16;
  77.    GotoXY(ColorMatrixX,ColorMatrixY);  { Move to new cursor postion and}
  78.    Blink_On;                           { set blinking attribute        }
  79.    End; {Move_Left}
  80.  
  81. Procedure Move_Up;                     { Move up one Row               }
  82.   Begin                                { Restore unblinking attributes }
  83.    Blink_Off;                          { to old cursor postion         }
  84.    ColorMatrixY := ColorMatrixY - 1;
  85.    If ColorMatrixY < 4 then ColorMatrixY := 4+7;
  86.    GotoXY(ColorMatrixX,ColorMatrixY);  { Move to new cursor postion and}
  87.    Blink_On;                           { set blinking attribute        }
  88.   end; {Move_Up}
  89.  
  90. Procedure Move_Down;                   { Move Down one Row             }
  91.    Begin                               { Restore unblinking attributes }
  92.    Blink_Off;                          { to old cursor postion         }
  93.    ColorMatrixY := ColorMatrixY + 1;
  94.    If ColorMatrixY > 4+7 then colorMatrixY := 4;
  95.    GotoXY(ColorMatrixX,ColorMatrixY);  { Move to new cursor postion and}
  96.    Blink_On;                           { set blinking attribute        }
  97.    end; {Move_Down}
  98.  
  99. Procedure Selected;                    { Pass back selected attribute  }
  100.    Begin
  101.    Blink_Off;                          { Turn off any linking          }
  102.    Get_Abs_Cursor(x,y);
  103.    Attr :=                             { Get old Cursor attributes     }
  104.         Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ] ;
  105.    End; {Procedure Selected }
  106. {-----------------------------------------------------------------------}
  107. {      M a i n  P r o c e d u r e  : Select Color and Return Attribute  }
  108. {-----------------------------------------------------------------------}
  109. Begin {Select_Color}
  110.  
  111.   Old_Attr := Attr;                           { Save old Attributes  }
  112.   Old_Text := Attr and $0F;
  113.   Old_background := Attr shr 4;
  114.   Get_Abs_Cursor(x,y);                        { Find Cursor and make }
  115.   MkWin(4,y,74,y+16,White);                   { a window/Set Color   }
  116.  
  117.   Fieldwidth := 4;                            { Colors Display Width }
  118.   TextColor(Old_Text);
  119.   clrscr;
  120.   GotoXY(14,1);  write('* * *   Move Cursor to Select Colors   * * *');
  121.   GotoXY(14,2);  write('Enter ');
  122.   TextColor(Old_Text+Blink);Write('[Return]');
  123.   TextColor(Old_Text);Write(' to select -- ');
  124.   TextColor(Old_Text+Blink); Write('[Esc]');
  125.   TextColor(Old_Text); Writeln(' to Ignore');
  126.   ColorMatrixX := WhereX; ColorMatrixY := WhereY;
  127.   For Background:=0 to 7 do            { Background Color attributes   }
  128.     Begin
  129.     for Foreground:=0 to 15 do         { Foreground Color attributes   }
  130.       begin                            { Display the Color matrix      }
  131.       gotoxy(Fieldwidth*(Foreground+1),Background+4); { display posn }
  132.       textcolor(Foreground);
  133.       textbackground(Background);
  134.       write(Foreground:Fieldwidth-1);
  135.       end; { Forground}
  136.   Writeln;
  137.   end; { Background }
  138.                                           { Put Cursor at Old Attriute }
  139.   ColorMatrixX := Fieldwidth * (Old_Text)+Fieldwidth;
  140.   ColorMatrixY := 4 + (Old_background);
  141.   GotoXY(ColorMatrixX,ColorMatrixY);      { Position the Cursor        }
  142.   Chval := 0;
  143.  
  144.   Repeat {until Chval=Return|Esc key}     { Get an attribute selection }
  145.   Chval := Keyin;                         { Wait for user key          }
  146.   Case Chval of
  147.        Arr_Right   : Move_Right;
  148.        Arr_Left    : Move_Left;
  149.        Arr_Up      : Move_Up;
  150.        Arr_Dn      : Move_Down;
  151.        Return      : Selected;
  152.        Esc         :
  153.   else Beep(600);
  154.   end; {case Chval}
  155.   Until (Chval=Return) or (Chval=Esc);
  156.   RmWin;                                  { Remove the Color Window    }
  157. end; {Select_Color}
  158. {.......................................................................}
  159.